home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vbboid / boid.bas < prev    next >
BASIC Source File  |  1999-09-16  |  34KB  |  937 lines
  1. Attribute VB_Name = "Module1"
  2. Option Explicit
  3. Declare Function LineTo Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
  4. Declare Function MoveToEx Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal lpPoint As Long) As Long
  5.  
  6. Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  7. Public Const SRCCOPY = &HCC0020         ' (DWORD) dest = source
  8. Public Const SRCINVERT = &H660046       ' (DWORD) dest = source XOR dest
  9. Public Const SRCPAINT = &HEE0086        ' (DWORD) dest = source OR dest
  10. Public Const SRCAND = &H8800C6          ' (DWORD) dest = source AND dest
  11.  
  12. Public Const PI = 3.1415926
  13. Public Const PI2 = 3.1415926 * 2
  14.  
  15. Public flock As New Collection
  16. Public objects As New Collection
  17.  
  18. Public Sub AddBoid(flock As Collection, X As Integer, Y As Integer, ByVal Dir As Integer, Bcol As Long)
  19. 'helper function to add Boid to the specified collection (flock)
  20. Dim Colour As Integer
  21. Dim boid As BoidClass
  22. Set boid = New BoidClass
  23.  
  24.     boid.X = X
  25.     boid.Y = Y
  26.     
  27.     boid.Colour = Bcol
  28.     boid.id = flock.Count
  29.     
  30.     boid.direction = Dir
  31.     boid.speed = 10
  32.     
  33.     flock.Add boid
  34.     Set boid = Nothing
  35. End Sub
  36.  
  37. Public Sub AddObstacle(objects As Collection, X As Integer, Y As Integer, ByVal Radius As Integer)
  38. Dim obs As ObstacleClass
  39. Set obs = New ObstacleClass
  40.  
  41.     obs.X = X
  42.     obs.Y = Y
  43.     
  44.     obs.id = objects.Count
  45.     
  46.     obs.Radius = Radius
  47.     
  48.     objects.Add obs
  49.     Set obs = Nothing
  50.     
  51. End Sub
  52.  
  53. Sub DrawBoid(flock As Collection, Canvas As PictureBox, ShowColours As Boolean, ShowArrow As Boolean, ShowCircle As Boolean)
  54. Dim boid As BoidClass
  55. Dim d As Integer
  56. Dim u%
  57. Dim NewX As Integer
  58. Dim NewY As Integer
  59.  
  60. Dim XDist As Integer
  61. Dim YDist As Integer
  62.  
  63. Dim AHx As Integer
  64. Dim AHy As Integer
  65. Dim Theta As Integer
  66. Dim Bcol As Long
  67.  
  68.     For Each boid In flock
  69.  
  70.         Theta = boid.direction
  71.         
  72.         If ShowColours = True Then
  73.             Bcol = boid.Colour
  74.         Else
  75.             Bcol = vbBlack
  76.         End If
  77.         
  78.         boid.NewY = boid.Y + (10 * Sin(boid.direction))
  79.         boid.NewX = boid.X + (10 * Cos(boid.direction))
  80.         
  81.         Canvas.Line (boid.X, boid.Y)-(boid.NewX, boid.NewY), Bcol
  82.         
  83.         If ShowCircle Then
  84.             Canvas.Circle (boid.X, boid.Y), 5, Bcol
  85.         End If
  86.         
  87.     'arrow head
  88.         If ShowArrow Then
  89.             AHx = 5 * Cos((Theta + 45))
  90.             AHy = 5 * Sin((Theta + 45))
  91.             Canvas.Line (boid.NewX, boid.NewY)-(boid.NewX - AHx, boid.NewY - AHy), Bcol
  92.             AHx = 5 * Cos((Theta - 45))
  93.             AHy = 5 * Sin((Theta - 45))
  94.             Canvas.Line (boid.NewX, boid.NewY)-(boid.NewX - AHx, boid.NewY - AHy), Bcol
  95.         End If
  96.         
  97.     Next
  98.     Set boid = Nothing
  99.  
  100.  
  101. End Sub
  102.  
  103. Sub DrawObjects(objects As Collection, Canvas As PictureBox)
  104. Dim obs As ObstacleClass
  105.     
  106.     For Each obs In objects
  107.  
  108.         Canvas.Circle (obs.X, obs.Y), obs.Radius
  109.         
  110.     Next
  111.     Set obs = Nothing
  112.  
  113.  
  114. End Sub
  115.  
  116. Sub DrawForces(flock As Collection, Canvas As PictureBox, SensorDist As Integer, ViewTheta As Single, ShowCentre As Boolean, ShowSep As Boolean, ShowAlign As Boolean, ShowSensor As Boolean, ShowBox As Boolean)
  117. Dim boid As BoidClass
  118. Dim d As Integer
  119. Dim u%
  120.  
  121. Dim tmpX1 As Integer
  122. Dim tmpY1 As Integer
  123. Dim tmpX2 As Integer
  124. Dim tmpY2 As Integer
  125. Dim tmpX3 As Integer
  126. Dim tmpY3 As Integer
  127. Dim tmpX4 As Integer
  128. Dim tmpY4 As Integer
  129.  
  130. Dim tmpStart As Single
  131. Dim tmpEnd As Single
  132. Dim HalfTheta As Single
  133.  
  134.     HalfTheta = ViewTheta / 2
  135.     For Each boid In flock
  136.  
  137.             If ShowSensor Then
  138.             
  139.                 tmpX1 = boid.X + (SensorDist * Cos(boid.direction + HalfTheta))
  140.                 tmpY1 = boid.Y + (SensorDist * Sin(boid.direction + HalfTheta))
  141.                 tmpX2 = boid.X + (SensorDist * Cos(boid.direction - HalfTheta))
  142.                 tmpY2 = boid.Y + (SensorDist * Sin(boid.direction - HalfTheta))
  143.                 
  144.                 tmpStart = PI2 - (boid.direction + HalfTheta)
  145.                 tmpEnd = PI2 - (boid.direction - HalfTheta)
  146.                    
  147.                 'Debug.Print tmpStart, tmpEnd
  148.                 
  149.                 If tmpStart > PI2 Then
  150.                     tmpStart = tmpStart - PI2
  151.                 End If
  152.                 If tmpStart < 0 Then
  153.                     tmpStart = tmpStart + PI2
  154.                 End If
  155.                 
  156.                 If tmpEnd > PI2 Then
  157.                     tmpEnd = tmpEnd - PI2
  158.                 End If
  159.                 If tmpEnd < 0 Then
  160.                     tmpEnd = tmpEnd + PI2
  161.                 End If
  162.             
  163.                 Canvas.Circle (boid.X, boid.Y), SensorDist, vbBlack, tmpStart, tmpEnd
  164.                 Canvas.Line (boid.X, boid.Y)-(tmpX1, tmpY1), vbBlack
  165.                 Canvas.Line (boid.X, boid.Y)-(tmpX2, tmpY2), vbBlack
  166.                 
  167.             End If
  168.  
  169.             If ShowCentre Then
  170.                 Canvas.Line (boid.X, boid.Y)-(boid.X + boid.DesireCentreX * 10, boid.Y + boid.DesireCentreY * 10), vbGreen
  171.             End If
  172.             
  173.             If ShowAlign Then
  174.                 Canvas.Line (boid.X, boid.Y)-(boid.X + boid.DesireAlignX * 10, boid.Y + boid.DesireAlignY * 10), vbMagenta
  175.             End If
  176.             
  177.             If ShowSep Then
  178.                 Canvas.Line (boid.X, boid.Y)-(boid.X + boid.DesireSeparateX * 10, boid.Y + boid.DesireSeparateY * 10), vbBlue
  179.             End If
  180.  
  181.  
  182. 'show box used for collision detection
  183.  
  184.             If ShowBox Then
  185.             'box to the right
  186.                 tmpX1 = boid.X + (5 * Cos(boid.direction + PI / 2))
  187.                 tmpY1 = boid.Y + (5 * Sin(boid.direction + PI / 2))
  188.                 tmpX2 = tmpX1 + (SensorDist * Cos(boid.direction))
  189.                 tmpY2 = tmpY1 + (SensorDist * Sin(boid.direction))
  190.     
  191.                 If boid.DesireAvoidRight = False Then
  192.                     Canvas.Line (boid.X, boid.Y)-(tmpX1, tmpY1), vbScrollBars
  193.                     Canvas.Line (tmpX1, tmpY1)-(tmpX2, tmpY2), vbScrollBars
  194.                 Else
  195.                     Canvas.Line (boid.X, boid.Y)-(tmpX1, tmpY1), vbRed
  196.                     Canvas.Line (tmpX1, tmpY1)-(tmpX2, tmpY2), vbRed
  197.                 End If
  198.                 
  199.             'box to the left
  200.                 tmpX3 = boid.X - (5 * Cos(boid.direction + PI / 2))
  201.                 tmpY3 = boid.Y - (5 * Sin(boid.direction + PI / 2))
  202.                 tmpX4 = tmpX3 + (SensorDist * Cos(boid.direction))
  203.                 tmpY4 = tmpY3 + (SensorDist * Sin(boid.direction))
  204.  
  205.                 If boid.DesireAvoidLeft = False Then
  206.                     Canvas.Line (boid.X, boid.Y)-(tmpX3, tmpY3), vbScrollBars
  207.                     Canvas.Line (tmpX3, tmpY3)-(tmpX4, tmpY4), vbScrollBars
  208.                 Else
  209.                     Canvas.Line (boid.X, boid.Y)-(tmpX3, tmpY3), vbRed
  210.                     Canvas.Line (tmpX3, tmpY3)-(tmpX4, tmpY4), vbRed
  211.                 End If
  212.                 
  213.             'complete box
  214.                 Canvas.Line (tmpX2, tmpY2)-(tmpX4, tmpY4), vbScrollBars
  215.             End If
  216.             
  217.     Next
  218.     Set boid = Nothing
  219.  
  220. End Sub
  221.  
  222. Public Sub CalcForces(flock As Collection, CentMult As Integer, SepMult As Integer, AliMult As Integer, SensorDist As Integer, ViewTheta As Single)
  223.     
  224.     Dim distance As Integer
  225.     Dim i%
  226.     Dim AveDir As Single
  227.     Dim AveX As Integer
  228.     Dim AveY As Integer
  229.     Dim AveSpeed As Single
  230.     
  231.     Dim boid As BoidClass
  232.     Dim obs As ObstacleClass
  233.     
  234.     Dim otherBoid As BoidClass
  235.         
  236.     Dim ClosestBoid As BoidClass
  237.     
  238.     Dim iLeaderX As Integer
  239.     Dim iLeaderY As Integer
  240.     
  241.     Dim CloseBoidCount As Integer
  242.     Dim GroupCount As Integer
  243.     'Dim CloseBoidCount As Integer
  244.     
  245.     Dim AllDirChange As Single
  246. '    Dim SensorDist As Integer
  247.     
  248.     Dim ClosestDist As Single
  249.     Dim TmpDist As Single
  250.     Dim TooClose As Boolean
  251.